createMessage = fromMaybe "branch created" <$> getCommitMessage
getCommitMessage :: Annex (Maybe String)
-getCommitMessage = do
- config <- Annex.getGitConfig
- case annexCommitMessageCommand config of
- Nothing -> return (annexCommitMessage config)
- Just cmd -> catchDefaultIO (annexCommitMessage config) $
- Just <$> liftIO (readProcess "sh" ["-c", cmd])
+getCommitMessage =
+ outputOfAnnexHook commitMessageAnnexHook annexCommitMessageCommand
+ <|>
+ (annexCommitMessage <$> Annex.getGitConfig)
{- Stages the journal, and commits staged changes to the branch. -}
commit :: String -> Annex ()
module Annex.Content.LowLevel where
import Annex.Common
+import Annex.Hook
import Logs.Transfer
import qualified Annex
import Utility.DiskFree
- File may or may not be deleted at the end; caller is responsible for
- making sure it's deleted. -}
secureErase :: RawFilePath -> Annex ()
-secureErase file = maybe noop go =<< annexSecureEraseCommand <$> Annex.getGitConfig
- where
- go basecmd = void $ liftIO $
- boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
- gencmd = massReplace [ ("%file", shellEscape (fromRawFilePath file)) ]
+secureErase = void . runAnnexPathHook "%file"
+ secureEraseAnnexHook annexSecureEraseCommand
data LinkedOrCopied = Linked | Copied
- git-annex not change, otherwise removing old hooks using an old
- version of the script would fail.
-
- - Copyright 2013-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
postUpdateAnnexHook :: Git.Hook
postUpdateAnnexHook = Git.Hook "post-update-annex" "" []
+freezeContentAnnexHook :: Git.Hook
+freezeContentAnnexHook = Git.Hook "freezecontent-annex" "" []
+
+thawContentAnnexHook :: Git.Hook
+thawContentAnnexHook = Git.Hook "thawcontent-annex" "" []
+
+secureEraseAnnexHook :: Git.Hook
+secureEraseAnnexHook = Git.Hook "secure-erase-annex" "" []
+
+commitMessageAnnexHook :: Git.Hook
+commitMessageAnnexHook = Git.Hook "commitmessage-annex" "" []
+
+httpHeadersAnnexHook :: Git.Hook
+httpHeadersAnnexHook = Git.Hook "http-headers-annex" "" []
+
mkHookScript :: String -> String
mkHookScript s = unlines
[ shebang
warning $ UnquotedString $
Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg
-{- Runs a hook. To avoid checking if the hook exists every time,
- - the existing hooks are cached. -}
-runAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex ()
-runAnnexHook hook commandcfg = do
+{- To avoid checking if the hook exists every time, the existing hooks
+ - are cached. -}
+doesAnnexHookExist :: Git.Hook -> Annex Bool
+doesAnnexHookExist hook = do
m <- Annex.getState Annex.existinghooks
case M.lookup hook m of
- Just True -> runhook
- Just False -> runcommandcfg
+ Just exists -> return exists
Nothing -> do
exists <- inRepo $ Git.hookExists hook
Annex.changeState $ \s -> s
{ Annex.existinghooks = M.insert hook exists m }
- if exists
- then runhook
- else runcommandcfg
+ return exists
+
+runAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex ()
+runAnnexHook hook commandcfg = ifM (doesAnnexHookExist hook)
+ ( runhook
+ , runcommandcfg
+ )
where
- runhook = unlessM (inRepo $ Git.runHook hook) $ do
+ runhook = unlessM (inRepo $ Git.runHook boolSystem hook []) $ do
h <- fromRepo $ Git.hookFile hook
commandfailed h
runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
commandfailed command
Nothing -> noop
commandfailed c = warning $ UnquotedString $ c ++ " failed"
+
+runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> RawFilePath -> Annex Bool
+runAnnexPathHook pathtoken hook commandcfg p = ifM (doesAnnexHookExist hook)
+ ( runhook
+ , runcommandcfg
+ )
+ where
+ runhook = inRepo $ Git.runHook boolSystem hook [ File (fromRawFilePath p) ]
+ runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
+ Just basecmd -> liftIO $
+ boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
+ Nothing -> return True
+ gencmd = massReplace [ (pathtoken, shellEscape (fromRawFilePath p)) ]
+
+outputOfAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex (Maybe String)
+outputOfAnnexHook hook commandcfg = ifM (doesAnnexHookExist hook)
+ ( runhook
+ , runcommandcfg
+ )
+ where
+ runhook = inRepo (Git.runHook runhook' hook [])
+ runhook' c ps = Just <$> readProcess c (toCommand ps)
+ runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case
+ Just command -> liftIO $
+ Just <$> readProcess "sh" ["-c", command]
+ Nothing -> return Nothing
) where
import Annex.Common
+import Annex.Hook
import Utility.FileMode
import Git
import Git.ConfigTypes
either throwM return v
hasFreezeHook :: Annex Bool
-hasFreezeHook = isJust . annexFreezeContentCommand <$> Annex.getGitConfig
+hasFreezeHook =
+ (isJust . annexFreezeContentCommand <$> Annex.getGitConfig)
+ <||>
+ (doesAnnexHookExist freezeContentAnnexHook)
hasThawHook :: Annex Bool
-hasThawHook = isJust . annexThawContentCommand <$> Annex.getGitConfig
+hasThawHook =
+ (isJust . annexThawContentCommand <$> Annex.getGitConfig)
+ <||>
+ (doesAnnexHookExist thawContentAnnexHook)
freezeHook :: RawFilePath -> Annex ()
-freezeHook p = maybe noop go =<< annexFreezeContentCommand <$> Annex.getGitConfig
- where
- go basecmd = void $ liftIO $
- boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
- gencmd = massReplace [ ("%path", shellEscape (fromRawFilePath p)) ]
+freezeHook = void . runAnnexPathHook "%path"
+ freezeContentAnnexHook annexFreezeContentCommand
thawHook :: RawFilePath -> Annex ()
-thawHook p = maybe noop go =<< annexThawContentCommand <$> Annex.getGitConfig
- where
- go basecmd = void $ liftIO $
- boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
- gencmd = massReplace [ ("%path", shellEscape (fromRawFilePath p)) ]
+thawHook = void . runAnnexPathHook "%path"
+ thawContentAnnexHook annexThawContentCommand
{- Calculate mode to use for a directory from the mode to use for a file.
-
import qualified Annex
import qualified Utility.Url as U
import qualified Utility.Url.Parse as U
+import Annex.Hook
import Utility.Hash (IncrementalVerifier)
import Utility.IPAddress
import Network.HTTP.Client.Restricted
<*> pure (Just (\u -> "Configuration of annex.security.allowed-url-schemes does not allow accessing " ++ show u))
<*> pure U.noBasicAuth
- headers = annexHttpHeadersCommand <$> Annex.getGitConfig >>= \case
- Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
- Nothing -> annexHttpHeaders <$> Annex.getGitConfig
+ headers =
+ outputOfAnnexHook httpHeadersAnnexHook annexHttpHeadersCommand
+ >>= \case
+ Just output -> pure (lines output)
+ Nothing -> annexHttpHeaders <$> Annex.getGitConfig
checkallowedaddr = words . annexAllowedIPAddresses <$> Annex.getGitConfig >>= \case
["all"] -> do
* git-remote-annex: Use enableremote rather than initremote.
* Windows: Fix permission denied error when dropping files that
have the readonly attribute set.
+ * Added freezecontent-annex and thawcontent-annex hooks that
+ correspond to the git configs annex.freezecontent and
+ annex.thawcontent.
+ * Added secure-erase-annex hook that corresponds to the git config
+ annex.secure-erase-command.
+ * Added commitmessage-annex hook that corresponds to the git config
+ annex.commitmessage-command.
+ * Added http-headers-annex hook that corresponds to the git config
+ annex.http-headers-command.
* Added git configs annex.post-update-command and annex.pre-commit-command
- that correspond to the git-annex hook scripts post-update-annex and
- pre-commit-annex.
+ that correspond to the post-update-annex and pre-commit-annex hooks.
-- Joey Hess <id@joeyh.name> Fri, 03 Jan 2025 14:30:38 -0400
doesFileExist f
#endif
-runHook :: Hook -> Repo -> IO Bool
-runHook h r = do
+runHook :: (FilePath -> [CommandParam] -> IO a) -> Hook -> [CommandParam] -> Repo -> IO a
+runHook runner h ps r = do
let f = hookFile h r
- (c, ps) <- findShellCommand f
- boolSystem c ps
+ (c, cps) <- findShellCommand f
+ runner c (cps ++ ps)
This command is run and its output is used as the commit message to the
git-annex branch.
+
+ Alternatively, a hook script can be installed in
+ `.git/hooks/commitmessage-annex`
* `annex.post-update-command`
This command is run after git-annex updates the git-annex branch.
- Alternatively, a hook script can be installed in
- `.git/hooks/post-update-annex`
-
When publishing a git-annex repository by http, this can be used to run
`git update-server-info`
+ Alternatively, a hook script can be installed in
+ `.git/hooks/post-update-annex`
+
* `annex.pre-commit-command`
This command is run whenever a commit is made to the HEAD branch of
erased.
For example, to use the wipe command, set it to `wipe -f %file`.
+
+ Alternatively to setting the git config, a hook script can be installed
+ in `.git/hooks/secure-erase-annex`
* `annex.freezecontent-command`, `annex.thawcontent-command`
Usually the write permission bits are unset to protect annexed objects
- from being modified or deleted. The freezecontent-command is run after
+ from being modified or deleted. Freezecontent is run after
git-annex has removed (or attempted to remove) the write bit, and can
be used to prevent writing in some other way.
- The thawcontent-command should undo its effect, and is run before
+ Tawcontent should undo its effect, and is run before
git-annex restores the write bit.
In the command line, %path is replaced with the file or directory to
operate on.
(When annex.crippledfilesystem is set, git-annex will not try to
- remove/restore the write bit, but it will still run these hooks.)
+ remove/restore the write bit, but it will still run freezecontent and
+ thawcontent.)
+
+ Alternatively to setting the git config, hook scripts can be installed
+ in `.git/hooks/freezecontent-annex` and `.git/hooks/thawcontent-annex`.
* `annex.tune.objecthash1`, `annex.tune.objecthashlower`, `annex.tune.branchhash1`
If set, the command is run and each line of its output is used as a HTTP
header. This overrides annex.http-headers.
+
+ Alternatively, a hook script can be installed in
+ `.git/hooks/http-headers-annex`
* `annex.security.allowed-url-schemes`
[[!meta author=yoh]]
[[!tag projects/repronim]]
+
+> [[done]] --[[Joey]]
for consistency.
There are some things like annex.youtube-dl-command and
-annex.http-headers-command that are configuring commands for git-annex to
+annex.shared-sop-command that are configuring commands for git-annex to
run, and are not really hooks per se.
And it does not make sense to have hook scripts that a specific to a given
remote corresponding to configs like `remote.name.annex-cost-command`.
-Instead it might make sense to have a `.git/hooks/remote-cost-annex` that
-is passed the name of the remote, but that bridge can be crossed if we
-come to it.
+Instead there could be a single `.git/hooks/remote-cost-annex` that
+is passed the name of the remote.
"""]]
--- /dev/null
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 7"""
+ date="2025-01-10T18:50:07Z"
+ content="""
+Implemented hooks: freezecontent-annex, thawcontent-annex,
+secure-erase-annex, commitmessage-annex, http-headers-annex
+
+That leaves only `remote.name.annex-cost-command` and similar git configs
+that don't have hooks. And a few like annex.youtube-dl-command that are not
+really equivilant to hooks.
+"""]]